Option Explicit

Dim InboxFolder As Long
Dim OutboxFolder As Long
Dim SavedFolder As Long
Dim DeletedFolder As Long

Private Function AddFolder(ByVal Folder As String, ByVal Desc As String, ByVal Count As Integer)
    Dim ItemIndex As Long
    With SftTree1
        ItemIndex = .Items.Add(Folder)    ' add folder
        .Cell(ItemIndex, 1).Text = Desc   ' add description
        .Cell(ItemIndex, 3).Text = Count  ' add number of messages
        .Cell(ItemIndex, 3).Data = Count  ' also save number of messages for sorting
        
        ' make the folder name bold
        .Cell(ItemIndex, 0).Font.Bold = True
        
        ' if this folder has no messages (ie. dependents), we still want the
        ' folder graphic, not the email (leaf) graphic
        If Count = 0 Then
            .Item(ItemIndex).Image = .Items.ItemImageExpandable
        End If
        AddFolder = .Item(ItemIndex).ID
    End With
End Function

Private Function AddMessage(ByVal Level As Integer, ByVal Email As String, ByVal Desc As String, ByVal Dt As String, ByVal Size As Integer, ByVal Attachment As Boolean)
    Dim ItemIndex As Long
    With SftTree1
        ItemIndex = .Items.Add(Email)    ' add folder
        .Item(ItemIndex).Level = Level
        .Cell(ItemIndex, 1).Text = Desc  ' add description
        .Cell(ItemIndex, 2).Text = Dt    ' add date
        .Cell(ItemIndex, 3).Text = Size & "K"
        .Cell(ItemIndex, 3).Data = Size ' also save size for sorting
        ' if this email has replies (ie. dependents), we still want the
        ' email graphic, not the expand folder image
        .Item(ItemIndex).Image = .Items.ItemImageLeaf
        ' if the email has an attachment, show the image
        If Attachment Then
            Set .Cell(ItemIndex, 1).Image.Picture = Attach.Picture
            .Cell(ItemIndex, 1).ImageHAlign = halignSftTreeRight
        End If
    End With
End Function

Private Sub Command1_Click()
    End
End Sub

Private Sub Form_Load()
    With SftTree1
        InboxFolder = AddFolder("Inbox", "Viewed and unviewed mail", 10)
            AddMessage 1, "support@softelvdm.com", "Re: A support question", "10/09/05", 88, True
            AddMessage 1, "anyone@acompany.com", "Re: Why did you say that", "10/10/05", 5, False
            AddMessage 1, "anyone@acompany.com", "Re: You're fired", "10/11/05", 82, True
            AddMessage 1, "anyone@acompany.com", "Re: You're hired", "10/11/05", 6, False
            .Item(.Items.ItemIndex(InboxFolder)).Collapse False
        OutboxFolder = AddFolder("Outbox", "Mail about to be sent", 2)
            AddMessage 1, "me@mycompany.com", "Re: You're fired", "10/11/05", 5, False
            AddMessage 1, "anyone@acompany.com", "Re: Why did you say that", "10/10/05", 5, False
            .Item(.Items.ItemIndex(OutboxFolder)).Collapse False
        SavedFolder = AddFolder("Saved", "Saved messages", 2)
            AddMessage 1, "me@mycompany.com", "A support question", "10/09/05", 3, False
            AddMessage 2, "support@softelvdm.com", "Re: A support question", "10/09/05", 88, True
            AddMessage 3, "me@mycompany.com", "Re: A support question", "10/09/05", 3, False
            AddMessage 1, "me@mycompany.com", "Why did you say that", "10/06/05", 5, False
            AddMessage 2, "anyone@acompany.com", "Re: Why did you say that", "10/10/05", 5, False
            AddMessage 1, "me@mycompany.com", "You're fired", "10/08/05", 2, False
            AddMessage 2, "anyone@acompany.com", "Re: You're fired", "10/11/05", 82, False
            AddMessage 1, "me@mycompany.com", "You're hired", "10/01/05", 4, False
            AddMessage 1, "anyone@acompany.com", "Re: You're hired", "10/11/05", 6, False
            .Item(.Items.ItemIndex(SavedFolder)).Collapse False
        DeletedFolder = AddFolder("Deleted", "Deleted messages", 0)
        .ColumnsObj.MakeOptimal
        .Items.RecalcHorizontalExtent
        .Splitter.MakeOptimal
        ' clear column header pictures
        .Header(1).Image.Clear
        .Header(2).Image.Clear
        .Header(3).Image.Clear
        .Items.Current = 0
        SftTree1_CaretChange 0  ' to update column headers
    End With
End Sub

Private Sub SftTree1_CaretChange(ByVal ItemIndex As Long)
    With SftTree1
        ' set column headers based on selected item
        Select Case .Item(ItemIndex).ID
        Case InboxFolder, OutboxFolder, SavedFolder, DeletedFolder
            .Header(0).Text = "Folder"
            .Header(1).Text = "Description"
            .Header(2).Text = ""    ' we can use this to merge the adjacent title
            .Header(3).Text = "Msgs"
        Case Else
            .Header(0).Text = "From"
            .Header(1).Text = "Subject"
            .Header(2).Text = "Received"
            .Header(3).Text = "Size"
        End Select
    End With
End Sub

Private Sub SftTree1_ItemClick(ByVal ItemIndex As Long, ByVal ColIndex As Integer, ByVal AreaType As Integer, ByVal Button As Integer, ByVal Shift As Integer)
    Dim Ascending As Boolean
    With SftTree1
        If AreaType = constSftTreeButton Then
            If .Item(ItemIndex).Expanded Then
                .Item(ItemIndex).Collapse True
            Else
                .Item(ItemIndex).Expand True, False
            End If
        ElseIf AreaType = constSftTreeText Then
            ' edit description
            If ColIndex = 1 Then
                .Cell(ItemIndex, ColIndex).Edit 0, 0
            End If
        ElseIf AreaType = constSftTreeColumnHeader Then
            Ascending = True
            If .Header(ColIndex).Image.Appearance = sftImageSortAsc Then
                Ascending = False
            End If
            
            ' we have to sort based on current column headers
            ' we saved a value in Item.Data telling us if it's a folder
            Select Case .Item(.Items.Current).ID
            Case InboxFolder, OutboxFolder, SavedFolder, DeletedFolder
                ' we're on a folder, so sort on folder level
                If Ascending Then
                    If ColIndex = 3 Then
                        ' last column is sorted by Cell.Data (numeric values)
                        .Items.SortDependents -1, ColIndex, sortSftTreeAscCellItemData
                    Else
                        .Items.SortDependents -1, ColIndex, sortSftTreeAscending
                    End If
                Else
                    If ColIndex = 3 Then
                        .Items.SortDependents -1, ColIndex, sortSftTreeDscCellItemData
                    Else
                        .Items.SortDependents -1, ColIndex, sortSftTreeDescending
                    End If
                End If
            Case Else
                ' we're on a message, sort inside folders
                ' now sort the dependents of all folders
                ItemIndex = 0
                Do
                    If Ascending Then
                        If ColIndex = 3 Then
                            ' last column is sorted by Cell.Data (numeric values)
                            .Items.SortDependents ItemIndex, ColIndex, sortSftTreeAscCellItemData
                        Else
                            .Items.SortDependents ItemIndex, ColIndex, sortSftTreeAscending
                        End If
                    Else
                        If ColIndex = 3 Then
                            .Items.SortDependents ItemIndex, ColIndex, sortSftTreeDscCellItemData
                        Else
                            .Items.SortDependents ItemIndex, ColIndex, sortSftTreeDescending
                        End If
                    End If
                    ItemIndex = .Item(ItemIndex).NextSibling
                Loop Until ItemIndex < 0
            
            End Select
                        
            ' change column header image
            .Header(0).Image.Clear
            .Header(1).Image.Clear
            .Header(2).Image.Clear
            .Header(3).Image.Clear
            If Ascending Then
                .Header(ColIndex).Image.Appearance = sftImageSortAsc
            Else
                .Header(ColIndex).Image.Appearance = sftImageSortDesc
            End If
            ' update column headers by calling CaretChange
            SftTree1_CaretChange .Items.Current
        End If
    End With
End Sub

Private Sub SftTree1_ItemDblClick(ByVal ItemIndex As Long, ByVal ColIndex As Integer, ByVal AreaType As Integer, ByVal Button As Integer, ByVal Shift As Integer)
    With SftTree1
        If AreaType = constSftTreeText Or AreaType = constSftTreeButton Then
            ' if an item on level 1 or lower is clicked, it's an
            ' email message, display message box
            If .Item(ItemIndex).Level > 0 And AreaType = constSftTreeText Then
                MsgBox ("You could be viewing the message from " & .Cell(ItemIndex, 0).Text & _
                    " with the subject '" & .Cell(ItemIndex, 1).Text & "'.")
            Else
                ' otherwise just expand or collapse the item
                If .Item(ItemIndex).Expanded Then
                    .Item(ItemIndex).Collapse True
                Else
                    .Item(ItemIndex).Expand True, False
                End If
            End If
        ElseIf AreaType = constSftTreeColumnRes Then
            If ColIndex >= 0 Then
                .Column(ColIndex).MakeOptimal
                .Items.RecalcHorizontalExtent
            Else
                .Splitter.MakeOptimal
            End If
        End If
    End With
End Sub

Private Sub SftTree1_EditAllowed(ByVal ItemIndex As Long, ByVal ColIndex As Integer, Allowed As Boolean)
    ' Only allow editing in column 1
    If ColIndex = 1 Then
      Allowed = True
    Else
      Allowed = False
    End If
End Sub

Private Sub SftTree1_EditInitializing(Window As stdole.OLE_HANDLE, vData As Variant, ByVal EditIndex As Long, ByVal EditCol As Integer, LeftPix As stdole.OLE_XPOS_PIXELS, TopPix As stdole.OLE_YPOS_PIXELS, WidthPix As stdole.OLE_XSIZE_PIXELS, HeightPix As stdole.OLE_YSIZE_PIXELS)
    Dim TextHeight As Integer
    ' LeftPix/TopPix/WidthPix/HeightPix describes the current cell area
    ' we need to return the position and size needed for editing.
    ' In this example, we use the height of the control on the form
    ' and center it over the cell.
    TextHeight = EditControl.Height / Screen.TwipsPerPixelX
    TopPix = TopPix + (HeightPix - TextHeight) / 2
    HeightPix = TextHeight

    EditControl.Width = Width * Screen.TwipsPerPixelX
    EditControl.Text = SftTree1.Cell(EditIndex, EditCol).Text
    EditControl.SelStart = 0
    EditControl.SelLength = 999
    
    ' Return the control's window handle
    Window = EditControl.hWnd

    ' Define navigation keys
    ' VK_TAB
    SftTree1.CellEditIntercept Asc(vbTab), cellEditInterceptSftTreeChar + cellEditInterceptSftTreeControlChar + cellEditInterceptSftTreeShiftChar
    ' VK_RETURN
    SftTree1.CellEditIntercept Asc(vbCr), cellEditInterceptSftTreeChar + cellEditInterceptSftTreeControlChar + cellEditInterceptSftTreeShiftChar
    ' VK_HOME
    SftTree1.CellEditIntercept 36, cellEditInterceptSftTreeControlChar
    ' VK_END
    SftTree1.CellEditIntercept 35, cellEditInterceptSftTreeControlChar
    ' VK_UP
    SftTree1.CellEditIntercept 38, cellEditInterceptSftTreeChar + cellEditInterceptSftTreeControlChar + cellEditInterceptSftTreeShiftChar
    ' VK_DOWN
    SftTree1.CellEditIntercept 40, cellEditInterceptSftTreeChar + cellEditInterceptSftTreeControlChar + cellEditInterceptSftTreeShiftChar
End Sub

Private Sub SftTree1_EditNavigating(ByVal Key As Long, ByVal Shift As Integer, ByVal ItemIndex As Long, ByVal ColIndex As Integer)
    ' Process key pressed
    SftTree1.EditNavigate Key, Shift
End Sub

Private Sub SftTree1_EditValidate(ByVal Window As stdole.OLE_HANDLE, ByVal vData As Variant, ByVal EditIndex As Long, ByVal EditCol As Integer, InputValid As Boolean)
    ' Validate the new cell contents
    If EditControl.Text = "" Then
        MsgBox ("Please enter a description.")
        InputValid = False
    End If
End Sub

Private Sub SftTree1_EditEnding(ByVal Window As stdole.OLE_HANDLE, ByVal vData As Variant, ByVal EditIndex As Long, ByVal EditCol As Integer, ByVal SaveInput As Boolean)
    ' Save the new cell contents
    If SaveInput Then
        SftTree1.Cell(EditIndex, EditCol).Text = EditControl.Text
    End If
End Sub